home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / foscom12.arc / FOSCOM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-26  |  10.0 KB  |  465 lines
  1. {
  2.                      Version 1.2  26-August-1989
  3.  
  4. ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
  5. █▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  6. █▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  7. █▒▒▒▒▒▒▒▒█████████████████████████████▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  8. █▒▒▒▒▒▒▒ ███                         ▒▒▒▒▒▒▒▒▒▒▒▒▒███▒▒▒▒┌──────────────────┐▒█
  9. █▒▒▒▒▒▒▒ ███▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ ███▒▒▒▒│   Ronen Magid's  │▒█
  10. █▒▒▒▒▒▒▒ ███▒▒▒▒▒████████▒▒███████▒▒███████▒▒███▒ ███▒▒▒▒│                  │▒█
  11. █▒▒▒▒▒▒▒ ███▒▒▒▒ ███  ███▒ ███   ▒▒ ███   ▒▒ ███▒ ███▒▒▒▒│      Fossil      │▒█
  12. █▒▒▒▒▒▒▒ ██████▒ ███▒ ███▒ ███▒▒▒▒▒ ███▒▒▒▒▒ ███▒ ███▒▒▒▒│      support     │▒█
  13. █▒▒▒▒▒▒▒ ███  ▒▒ ███▒ ███▒ ███████▒ ███████▒ ███▒ ███▒▒▒▒│     unit for     │▒█
  14. █▒▒▒▒▒▒▒ ███▒▒▒▒ ███▒ ███▒     ███▒     ███▒ ███▒ ███▒▒▒▒│                  │▒█
  15. █▒▒▒▒▒▒▒ ███▒▒▒▒ ███▒ ███▒▒▒▒  ███▒▒▒▒  ███▒ ███▒ ███▒▒▒▒│   TURBO PASCAL   │▒█
  16. █▒▒▒▒▒▒▒ ███▒▒▒▒ ████████▒▒███████▒▒███████▒ ███▒ ███▒▒▒▒│     versions     │▒█
  17. █▒▒▒▒▒▒▒   ▒▒▒▒▒        ▒▒       ▒▒       ▒▒   ▒▒   ▒▒▒▒▒│       4,5        │▒█
  18. █▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒└──────────────────┘▒█
  19. █▒▒▒████████████████████████████████████████████████████▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  20. █▒▒                                                    ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  21. █▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  22. ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
  23.  
  24.           Copyright (c) 1989 by Ronen Magid. Tel (972)-52-917663 VOICE
  25.                              972-52-27271 2400 24hrs
  26.  
  27.  
  28. }
  29.  
  30. UNIT FOSCOM;
  31.  
  32. INTERFACE
  33.  
  34. Uses Dos,CRT;
  35.  
  36.   VAR
  37.    REGS: Registers;                    {Registers used by Intr and Ms-Dos}
  38.  
  39.  
  40.  
  41. {             Available user Procedures and Functions                     }
  42.  
  43. Procedure Fos_Init       (Comport: Byte);
  44. Procedure Fos_Close      (Comport: Byte);
  45. Procedure Fos_Parms      (Comport: Byte; Baud: Integer; DataBits: Byte;
  46.                           Parity: Char; StopBit: Byte);
  47. Procedure Fos_Dtr        (Comport: Byte; State: Boolean);
  48. Procedure Fos_Flow       (Comport: Byte; State: Boolean);
  49. Function  Fos_CD         (Comport: Byte) : Boolean;
  50. Procedure Fos_Kill_Out   (Comport: Byte);
  51. Procedure Fos_Kill_In    (Comport: Byte);
  52. Procedure Fos_Flush      (Comport: Byte);
  53. Function  Fos_Avail      (Comport: Byte) : Boolean;
  54. Function  Fos_OkToSend   (Comport: Byte) : Boolean;
  55. Function  Fos_Empty      (Comport: Byte) : Boolean;
  56. Procedure Fos_Write      (Comport: Byte; Character: Char);
  57. Procedure Fos_String     (Comport: Byte; OutString: String);
  58. Procedure Fos_StringCRLF (Comport: Byte; OutString: String);
  59. Procedure Fos_Ansi       (Character: Char);
  60. Procedure Fos_Bios       (Character: Char);
  61. Procedure Fos_WatchDog   (Comport: Byte; State: Boolean);
  62. Function  Fos_Receive    (Comport: Byte) : Char;
  63. function  Fos_Hangup     (Comport: Byte) : Boolean;
  64. Procedure Fos_Reboot;
  65. Function  Fos_CheckModem (Comport: Byte) : Boolean;
  66. Function  Fos_AtCmd      (Comport: Byte; Command: String)  : Boolean;
  67. Procedure Fos_Clear_Regs;
  68.  
  69.  
  70. IMPLEMENTATION
  71.  
  72. Procedure Fos_Clear_Regs;
  73. Begin
  74.   Fillchar (Regs, SizeOf (Regs), 0);
  75. end;
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82. Procedure Fos_Init  (Comport: Byte);
  83. Begin
  84.  Fos_Clear_Regs;
  85.  With Regs Do
  86.  Begin
  87.     AH := 4;
  88.     DX := (ComPort-1);
  89.     Intr ($14, Regs);
  90.     If AX <> $1954 then
  91.     begin
  92.     writeln;
  93.       Writeln (' Fossil driver is not loaded.');
  94.       halt (1);
  95.     end;
  96.   end;
  97. end;
  98.  
  99. Procedure Fos_Close (Comport: Byte);
  100. Begin
  101.   Fos_Clear_Regs;
  102.   Fos_Dtr(Comport,False);
  103.  
  104.   With Regs Do
  105.   Begin
  106.     AH := 5;
  107.     DX := (ComPort-1);
  108.     Intr ($14, Regs);
  109.   end;
  110. end;
  111.  
  112.  
  113. Procedure Fos_Parms (ComPort: Byte; Baud: Integer; DataBits: Byte; Parity: Char;
  114.                      StopBit: Byte);
  115. Var
  116.  Code: Integer;
  117.  
  118. Begin
  119.   Code:=0;
  120.   Fos_Clear_Regs;
  121.     Case Baud of
  122.       0 : Exit;
  123.     100 : code:=code+000+00+00;
  124.     150 : code:=code+000+00+32;
  125.     300 : code:=code+000+64+00;
  126.     600 : code:=code+000+64+32;
  127.     1200: code:=code+128+00+00;
  128.     2400: code:=code+128+00+32;
  129.     4800: code:=code+128+64+00;
  130.     9600: code:=code+128+64+32;
  131.   end;
  132.  
  133.   Case DataBits of
  134.     5: code:=code+0+0;
  135.     6: code:=code+0+1;
  136.     7: code:=code+2+0;
  137.     8: code:=code+2+1;
  138.   end;
  139.  
  140.   Case Parity of
  141.     'N','n': code:=code+00+0;
  142.     'O','o': code:=code+00+8;
  143.     'E','e': code:=code+16+8;
  144.   end;
  145.  
  146.   Case StopBit of
  147.     1: code := code + 0;
  148.     2: code := code + 4;
  149.   end;
  150.  
  151.   With Regs do
  152.   begin
  153.     AH := 0;
  154.     AL := Code;
  155.     DX := (ComPort-1);
  156.     Intr ($14, Regs);
  157.   end;
  158. end;
  159.  
  160. Procedure Fos_Dtr   (Comport: Byte; State: Boolean);
  161. Begin
  162.   Fos_Clear_Regs;
  163.   With Regs do
  164.   begin
  165.     AH := 6;
  166.     DX := (ComPort-1);
  167.     Case State of
  168.     True : AL := 1;
  169.     False: AL := 0;
  170.     end;
  171.     Intr ($14, Regs);
  172.   end;
  173. end;
  174.  
  175.  
  176. Function  Fos_CD    (Comport: Byte) : Boolean;
  177. Begin
  178.   Fos_Clear_Regs;
  179.   With Regs do
  180.   Begin
  181.     AH := 3;
  182.     DX := (ComPort-1);
  183.     Intr ($14, Regs);
  184.     Fos_Cd := ((AL AND 128) = 128);
  185.   end;
  186. end;
  187.  
  188.  
  189. Procedure Fos_Flow  (Comport: Byte; State: Boolean);
  190. Begin
  191.   Fos_Clear_Regs;
  192.     With Regs do
  193.     Begin
  194.     AH := 15;
  195.     DX := ComPort-1;
  196.     Case State of
  197.       TRUE:  AL := 255;
  198.       FALSE: AL := 0;
  199.     end;
  200.     Intr ($14, Regs);
  201.   end;
  202. end;
  203.  
  204. Procedure Fos_Kill_Out (Comport: Byte);
  205. Begin
  206.   Fos_Clear_Regs;
  207.     With Regs do
  208.     begin
  209.     AH := 9;
  210.     DX := ComPort-1;
  211.     Intr ($14, Regs);
  212.   end;
  213. end;
  214.  
  215.  
  216. Procedure Fos_Kill_In  (Comport: Byte);
  217. Begin
  218.   Fos_Clear_Regs;
  219.   With Regs do
  220.   begin
  221.     AH := 10;
  222.     DX := ComPort-1;
  223.     Intr ($14, Regs);
  224.   end;
  225. end;
  226.  
  227. Procedure Fos_Flush    (Comport: Byte);
  228. Begin
  229.   Fos_Clear_Regs;
  230.   With Regs do
  231.   Begin
  232.     AH := 8;
  233.     DX := ComPort-1;
  234.     Intr ($14, Regs);
  235.   end;
  236. end;
  237.  
  238. Function  Fos_Avail    (Comport: Byte) : Boolean;
  239. Begin
  240.   Fos_Clear_Regs;
  241.   With Regs do
  242.   Begin
  243.     AH := 3;
  244.     DX := ComPort-1;
  245.     Intr ($14, Regs);
  246.     Fos_Avail:= ((AH AND 1) = 1);
  247.   end;
  248. end;
  249.  
  250. Function  Fos_OkToSend (Comport: Byte) : Boolean;
  251. Begin
  252.   Fos_Clear_Regs;
  253.   With Regs do
  254.   Begin
  255.     AH := 3;
  256.     DX := ComPort-1;
  257.     Intr ($14, Regs);
  258.     Fos_OkToSend := ((AH AND 32) = 32);
  259.   end;
  260. end;
  261.  
  262.  
  263. Function  Fos_Empty (Comport: Byte) : Boolean;
  264. Begin
  265.   Fos_Clear_Regs;
  266.   With Regs do
  267.   Begin
  268.     AH := 3;
  269.     DX := ComPort-1;
  270.     Intr ($14, Regs);
  271.     Fos_Empty := ((AH AND 64) = 64);
  272.   end;
  273. end;
  274.  
  275. Procedure Fos_Write     (Comport: Byte; Character: Char);
  276. Begin
  277.   Fos_Clear_Regs;
  278.   With Regs do
  279.   Begin
  280.     AH := 1;
  281.     DX := ComPort-1;
  282.     AL := ORD (Character);
  283.     Intr ($14, Regs);
  284.   end;
  285. end;
  286.  
  287.  
  288. Procedure Fos_String   (Comport: Byte; OutString: String);
  289. Var
  290.  Pos: Byte;
  291.  
  292. begin
  293.   For Pos := 1 to Length(OutString) do
  294.   begin
  295.      Fos_Write(Comport,OutString[Pos]);
  296.    end;
  297. OutString:='';
  298. end;
  299.  
  300.  
  301. Procedure Fos_StringCRLF  (Comport: Byte; OutString: String);
  302. Var
  303.  Pos: Byte;
  304.  
  305. begin
  306.   For Pos := 1 to Length(OutString) do
  307.   begin
  308.      Fos_Write(ComPort,OutString[Pos]);
  309.    end;
  310.    Fos_Write(ComPort,Char(13));
  311.    Fos_Write(ComPort,Char(10));
  312.    OutString:='';
  313. end;
  314.  
  315. Procedure Fos_Bios     (Character: Char);
  316.  Begin
  317.    Fos_Clear_Regs;
  318.    With Regs do
  319.    begin
  320.      AH := 21;
  321.      AL := ORD (Character);
  322.      Intr ($14, Regs);
  323.   end;
  324. end;
  325.  
  326.  
  327. Procedure Fos_Ansi     (Character: Char);
  328. begin
  329.   Fos_Clear_Regs;
  330.   With Regs do
  331.   Begin
  332.     AH := 2;
  333.     DL := ORD (Character);
  334.     Intr ($21, Regs);
  335.   end;
  336. end;
  337.  
  338.  
  339. Procedure Fos_WatchDog (Comport: Byte; State: Boolean);
  340. Begin
  341.   Fos_Clear_Regs;
  342.   With Regs do
  343.   Begin
  344.     AH := 20;
  345.     DX := ComPort-1;
  346.     Case State of
  347.       TRUE  : AL := 1;
  348.       FALSE : AL := 0;
  349.     end;
  350.     Intr ($14, Regs);
  351.   end;
  352. end;
  353.  
  354.  
  355. Function Fos_Receive  (Comport: Byte) : Char;
  356. Begin
  357.   Fos_Clear_Regs;
  358.   With Regs do
  359.   Begin
  360.     AH := 2;
  361.     DX := ComPort-1;
  362.     Intr ($14, Regs);
  363.     Fos_Receive := Chr(AL);
  364.   end;
  365. end;
  366.  
  367.  
  368. Function Fos_Hangup   (Comport: Byte) : Boolean;
  369. var
  370.   Tcount : Integer;
  371.  
  372. begin
  373.   Fos_Dtr(Comport,FALSE);
  374.   delay (600);
  375.   Fos_Dtr(Comport,TRUE);
  376.   if FOS_CD (ComPort)=true then begin
  377.     Tcount:=1;
  378.       repeat
  379.         Fos_String (Comport,'+++');
  380.         delay (3000);
  381.         Fos_StringCRLF (Comport,'ATH0');
  382.         delay(3000);
  383.         if Fos_CD (ComPort)=false then tcount:=3;
  384.         Tcount:=Tcount+1;
  385.       until Tcount=4;
  386.   end;
  387.  
  388.   if Fos_Cd (ComPort)=true then Fos_Hangup:=False Else Fos_Hangup:=True;
  389. end;
  390.  
  391.  
  392. Procedure Fos_Reboot;
  393. Begin
  394.   Fos_Clear_Regs;
  395.   With Regs do
  396.   Begin
  397.     AH := 23;
  398.     AL := 1;
  399.     Intr ($14, Regs);
  400.   end;
  401. end;
  402.  
  403. Function Fos_CheckModem (Comport: Byte) : Boolean;
  404. Var
  405.   Ch     :   Char;
  406.   Result :   String[10];
  407.   I,Z    :   Integer;
  408.  
  409. Begin
  410.   Fos_CheckModem:=FALSE;
  411.   Result:='';
  412.   For Z:=1 to 3 do begin
  413.     Delay(500);
  414.     Fos_Write (Comport,Char(13));
  415.     Delay(1000);
  416.     Fos_StringCRLF (Comport,'AT');
  417.     Delay(1000);
  418.     Repeat
  419.       If Fos_Avail (Comport) then Begin
  420.         Ch:=Fos_Receive(Comport);
  421.         Result:=Result+Ch;
  422.       end;
  423.     Until Fos_Avail(1)=FALSE;
  424.     For I:=1 to Length(Result) do Begin
  425.       If Copy(Result,I,2)='OK' then Begin
  426.         Fos_CheckModem:=TRUE;
  427.        Exit;
  428.       end;
  429.     end;
  430.   end;
  431. End;
  432.  
  433.  
  434. Function Fos_AtCmd (Comport: Byte; Command: String) : Boolean;
  435. Var
  436.   Ch     :   Char;
  437.   Result :   String[10];
  438.   I,Z    :   Integer;
  439.  
  440. Begin
  441.   Fos_AtCmd:=FALSE;
  442.   Result:='';
  443.   For Z:=1 to 3 do begin
  444.     Delay(500);
  445.     Fos_Write (Comport,Char(13));
  446.     Delay(1000);
  447.     Fos_StringCRLF (Comport,Command);
  448.     Delay(1000);
  449.     Repeat
  450.       If Fos_Avail (Comport) then Begin
  451.         Ch:=Fos_Receive(Comport);
  452.         Result:=Result+Ch;
  453.       end;
  454.     Until Fos_Avail(1)=FALSE;
  455.     For I:=1 to Length(Result) do Begin
  456.       If Copy(Result,I,2)='OK' then Begin
  457.         Fos_AtCmd:=TRUE;
  458.        Exit;
  459.       end;
  460.     end;
  461.   end;
  462. End;
  463.  
  464. END.
  465.